home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tpl60n19.zip / TESTPRGS.ZIP / ROUNDTST.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-12  |  3KB  |  115 lines
  1. {$N+}
  2.  
  3. USES Fun1_TP6;
  4.  
  5. VAR X,Y,Z: REAL;
  6.     I,II,LL,L,K:  LONGINT;
  7.     XA:ARRAY [1..6] OF BYTE ABSOLUTE X;
  8.  
  9. BEGIN
  10.    Y := 4.5;
  11.    Z := 5.5;
  12.    WriteLn ('Testing implementation of Round/Trunc for correct range and IEEE-rounding');
  13.    WriteLn;
  14.    WriteLn;
  15.    Write   ('Testing range of Round towards lower limit ... ');
  16.    X := -2147483647.0;
  17.    REPEAT
  18.       I := Round_TP60 (X);
  19. (*    WriteLn (X+2147483648.0);*)
  20.       X := X - 1.0/256.0;
  21.    UNTIL X <= -2147483648.5;
  22.    WriteLn ('passed');
  23.    WriteLn;
  24.    Write   ('Testing range of Round towards upper limit ... ');
  25.    X := 2147483647.0;
  26.    REPEAT
  27.       I := Round_TP60 (X);
  28. (*    writeln (x-2147483648.0);*)
  29.       X := X + 1.0/256.0;
  30.    UNTIL X >= 2147483647.5;
  31.    WriteLn ('passed');
  32.    WriteLn;
  33.    Write   ('Testing range of Trunc towards lower limit ... ');
  34.    X := -2147483647.0;
  35.    REPEAT
  36.       I := Trunc_TP60 (X);
  37. (*    writeln (x+2147483648.0);*)
  38.       X := X - 1.0/256.0;
  39.    UNTIL X <= -2147483649.0;
  40.    WriteLn ('passed');
  41.    WriteLn;
  42.    Write   ('Testing range of Trunc towards upper limit ... ');
  43.    X := 2147483647.0;
  44.    REPEAT
  45.       I := Trunc_TP60 (X);
  46. (*    writeln (x-2147483648.0);*)
  47.       X := X + 1.0/256.0;
  48.    UNTIL X >= 2147483648.0;
  49.    WriteLn ('passed');
  50.    WriteLn;
  51.    Write   ('Round (4.5) should be: 4, actual value is: ', Round (Y));
  52.    IF Round_Tp60 (Y) = 4 THEN
  53.       WriteLn ('   passed')
  54.    ELSE
  55.       WriteLn ('   failed');
  56.    Write   ('Round (5.5) should be: 6, actual value is: ', Round (Z));
  57.    IF Round_TP60 (Z) = 6 THEN
  58.       WriteLn ('   passed')
  59.    ELSE
  60.       WriteLn ('   failed');
  61.    WriteLn;
  62.    Y := -4.5;
  63.    Z := -5.5;
  64.    Write   ('Round (-4.5) should be:-4, actual value is:', Round (Y));
  65.    IF Round_Tp60 (Y) =-4 THEN
  66.       WriteLn ('  passed')
  67.    ELSE
  68.       WriteLn ('  failed');
  69.    Write   ('Round (-5.5) should be:-6, actual value is:', Round (Z));
  70.    IF Round_TP60 (Z) =-6 THEN
  71.       WriteLn ('  passed')
  72.    ELSE
  73.       WriteLn ('  failed');
  74.    WriteLn;
  75.    WriteLn ('Testing full range of Trunc and Round functions');
  76.    WriteLn;
  77.    WriteLn;
  78.    X := 0.0;
  79.    WHILE X < 2147483647.0 DO BEGIN
  80.       I := Trunc_TP60 (X);
  81.       II:= Trunc (X);
  82.       L := Round_TP60 (X);
  83.       LL:= Round (X);
  84.       IF I <> II THEN BEGIN
  85.          WriteLn;
  86.          WriteLn ('Error in Trunc:', X, I:10, II:10);
  87.          END;
  88.       IF L <> LL THEN BEGIN
  89.          WriteLn;
  90.          WriteLn ('Error in Round:', X, L:10, LL:10);
  91.          FOR K := 1 to 6 do begin
  92.            Write(XA[k]:4);
  93.          end; {endfor}
  94.          writeln;
  95.          END;
  96.       I := Trunc_TP60 (-X);
  97.       II:= Trunc (-X);
  98.       L := Round_TP60 (-X);
  99.       LL:= Round (-X);
  100.       IF I <> II THEN BEGIN
  101.          WriteLn;
  102.          WriteLn ('Error in Trunc:', X, I:10, II:10);
  103.          END;
  104.       IF L <> LL THEN BEGIN
  105.          WriteLn;
  106.          WriteLn ('Error in Round:', X, L:10, LL:10);
  107.          END;
  108.       IF (I AND $FF) = 0 THEN
  109.          Write (#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8, 'X= ', X);
  110.       X := X + 0.5;
  111.     END;
  112.     WriteLn;
  113.     WriteLn ('Test complete!');
  114. END.
  115.